home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / TIMER.SEQ < prev    next >
Text File  |  1988-06-28  |  2KB  |  60 lines
  1. \ TIMER.SEQ      Time measurment words for F-PC.
  2.  
  3. : GETDATE       ( --- Y MD ) 0 0 42 OS2 DROP ;
  4.  
  5. : SETDATE       ( NM Y --- ) SWAP 43 OS2 NIP NIP 255 =
  6.                 IF      CR ." Invalid DATE " THEN ;
  7.  
  8. : GETTIME       ( --- HM Sh ) 0 0 44 OS2 DROP ;
  9.  
  10. : SETTIME       ( HM Sh --- ) SWAP 45 OS2 NIP NIP 255 =
  11.                 IF      CR ." Invalid TIME " THEN ;
  12.  
  13. : .##           ( N1 --- )      \ Print two low digits of n1.
  14.                 0 <# # # #> TYPE ;
  15.  
  16. : <.HM>         ( D1 --- N1 )
  17.                 SWAP 0 256 UM/MOD .## ." :" .## ;
  18.  
  19. : <.SH>         ( N1 --- )
  20.                 ." :" 0 256 UM/MOD .## ." ." .## ;
  21.  
  22. : <.TIME>       BASE @ >R DECIMAL SWAP 0 256 UM/MOD .## ." :" .##
  23.                                  ." :" 0 256 UM/MOD .## ." ." .##
  24.                 R> BASE ! SPACE ;
  25.  
  26. : .TIME         GETTIME <.TIME> ;
  27.  
  28. : <.DATE>       ( D1 --- )
  29.                 BASE @ >R DECIMAL
  30.                 0 256 UM/MOD .## ." /" .## ." /" 1900 - .##
  31.                 R> BASE ! ;
  32.  
  33. : .DATE         GETDATE <.DATE> ;
  34.  
  35. VARIABLE STIME 0 ,
  36. VARIABLE TTIME 0 ,
  37.  
  38. : T>B           0 256 UM/MOD 100 * + SWAP 0 SWAP
  39.                 0 256 UM/MOD >R 6000 *D D+ R> 1000 * 360 *D D+ ;
  40.  
  41. : B>T           0 100 UM/MOD >R 100 UM/MOD SWAP TTIME C!
  42.                              R>  60 UM/MOD SWAP TTIME 1+ C!
  43.                                  60   /MOD      TTIME 3 + C!
  44.                                                 TTIME 2+ C! ;
  45.  
  46. : TIME-RESET    GETTIME T>B STIME 2! ;  \ RESET TIMER
  47.  
  48. : TIME-ELAPSED  GETTIME T>B STIME 2@ D- ; ( - D1 ) \ BINARY
  49.  
  50. : B>SEC         ( D1 - N1 )      \ CONVERT DOUBLE BINARY TO
  51.                 0 100 UM/MOD DROP   \ SECONDS, OVERFLOW AT 18 HRS
  52.                   100 UM/MOD NIP ;
  53.  
  54. : <.ELAPSED>    TIME-ELAPSED B>T TTIME 2@ <.TIME> ;
  55.  
  56. : .ELAPSED      CR ." Elapsed time   =  " <.ELAPSED> ;
  57.  
  58. : TIMER         TIME-RESET INTERPRET .ELAPSED ;
  59.  
  60.